perm filename CB.OLD[MSS,LCS] blob sn#107248 filedate 1974-06-15 generic text, type T, neo UTF8
	SUBROUTINE CMBN
	COMMON /RC/MCLEF(400),IST(4000)
	COMMON /FL/NX,N,L,M,NM,J,NT
	DIMENSION IP(10),NMS(10),NF(2500)
	EQUIVALENCE (IP,IST(3001)),(NMS,IST(3020)),(NF,IST(201))
C *****   ******   ****   ******              ↑ 20 FOR OVERRUN IN IP(11) AT 119
C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  400 WD LIMIT PER FILE.
	IF(N.EQ.'S')GO TO 103
102	TYPE 1
1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
10	FORMAT(A5)
	DO 122 K=1,10
122	NMS(K)=' '
	ACCEPT 10,NM
	IF(NM.NE.' ')GO TO 40
	NM=LASTNM
	TYPE 107,J,LASTNM
40	LASTNM=NM
	IF(LOOKD(NM).EQ.0)GO TO 100
	IF(N.NE.'C')GO TO 103
C  FOR ADDING TO COMBINED FILE.
	TYPE 101,NM
	ACCEPT 10,NX
	IF(NX.EQ.'N')GO TO 102
100	IF(N.EQ.'C')GO TO 104
	TYPE 52
	GO TO 102
104	NX=0
	IP(1)=1
	L=1
	J=1
	I=0
30	TYPE 41
41	FORMAT(' TYPE FILE NAME ',$)
	ACCEPT 10,NW
	IF(NW.EQ.' ')GO TO 8
	IF(LOOKD(NW))GO TO 51
	TYPE 52
	GO TO 30
52	FORMAT(' FILE NOT FOUND'/)
51	I=I+1
	NMS(I)=NW
	CALL IFILE(20,NW)
	IP(L)=J
	READ(20,5)M,M,M,M
50	READ(20,5)M,M,(MCLEF(K),K=J,J+M-1)
	NX=NX+MCLEF(J)
	IF(NX.LT.M)M=NX
7	J=J+M
	READ(20,5,END=62)M,M,(MCLEF(K),K=J,J+M-1)
	IF(M)GO TO 62
	GO TO 7
62	J=NX+1
	L=L+1
	IF(L.LT.11)GO TO 30
CC	GO TO 80
101	FORMAT(' WRITE OVER ',A5,'.DAT?  Y OR N?  ',$)
8	CALL OFILE(1,NM)
	IP(L)=NX+1
	NX=NX-1
	IF(L.EQ.10)GO TO 80
	DO 81 K=L+1,10
81	IP(K)=0
80	WRITE(1,9)IP
	J=1
	NT=0
14	CALL SAVE(MCLEF(J))
	NT=NT+MCLEF(J)+1
11	IF(NT.GT.NX)GO TO 4
	J=NT
	NT=NT-1
	GO TO 14
6	FORMAT(' 9999 ',10A5)
4	WRITE (1,6),NMS
	RETURN
9	FORMAT(' 9999 ',10I6)
5	FORMAT(12I)

1103	TYPE 1104,ID
1104	FORMAT(' FILE FULL -- SAVED AS ',A5)
	L=1
	NM=ID
	NX=MCLEF(1)
	GO TO 8

103	CALL IFILE(20,NM)
	READ(20,5)K,IP
	NX=1
105	READ(20,5,END=106)K,K,(NF(L),L=NX,NX+K-1)
	REREAD 107,L,NMS
	IF(NMS(1))GO TO 106
	NX=NX+K
	GO TO 105
107	FORMAT(I,10A5)
106	TYPE 108,NMS
108	FORMAT(' IDENT. NAMES:'/,10(2XA5))
	IF(N.EQ.'S')RETURN
C  JUST PRINTS OUT NAMES
	TYPE 109
109	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
	ACCEPT 209,ID
	IF(ID.EQ.' ')GO TO 102
209	FORMAT(A5)
	JD=0
	L=0
	NX=NX-1
	DO 110 K=1,10
	IF(NMS(K).EQ.ID)JD=K
	IF(NMS(K).EQ.' ')GO TO 112
	L=K
110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
112	IF(N.EQ.'Z')GO TO 127
C  FOR DELETIONS
	L=L+1
	IF(JD.NE.0)GO TO 111
C ADDS ON TO END
	N=0
	DO 113 K=NX+1,MCLEF(1)+NX
	N=N+1
113	NF(K)=MCLEF(N)
	NX=NX+N
	NMS(L)=ID
	L=L+1
114	DO 115 K=1,NX
115	MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
	GO TO 8

127	MCLEF(1)=0
111	N=IP(JD)
	NR=MCLEF(1)
	M=NF(IP(JD))
	NW=NR-M
	NX=NX+NW
	IF(NW)201,120,203
201	JA=N+NR
	JB=NX
	JC=1
	GO TO 204
203	JA=NX
	JB=N+NW
	JC=-1
204	DO 121 K=JA,JB,JC
121	NF(K)=NF(K-NW)
	IF(NR.EQ.0)GO TO 126
120	DO 117 K=1,NR
	NF(N)=MCLEF(K)
117	N=N+1 
CC	L=L-1
	IF(NW.EQ.0)GO TO 114
	DO 119 K=JD+1,L
119	IP(K)=IP(K)+NW
C  FIXES UP FIRST LINE.
CC123	L=L-1
CC	NX=NX-1
	GO TO 114
126	IP(L+1)=0
CC	L=L-1
	DO 124 K=JD,L-1
	IP(K)=IP(K+1)+NW
124	NMS(K)=NMS(K+1)
	NMS(L)=' '
	GO TO 114
	END

	SUBROUTINE ITEM
	COMMON /FL/JT,N,L,M,NM,J,NT
	I=N
	N='S'
C  S=SEE
	TYPE 1
1	FORMAT(
	1'  0      1      2      3      4      5      6      7
	1      8      9')
	CALL CMBN
	N=I
	END